home *** CD-ROM | disk | FTP | other *** search
/ 64'er Special 27 / 64er_Magazin_Sonderheft_27_19xx_Markt__Technik_de_Disk_2_of_2_Side_A.d64 / giga grafik src (.txt) < prev    next >
Commodore BASIC  |  2022-10-26  |  28KB  |  1,508 lines
  1. 10 ; ##############################
  2. 20 ; #                            #
  3. 30 ; #      c 64 & giga-ass       #
  4. 40 ; #                            #
  5. 50 ; # grafik-routinen, vers. 1.1 #
  6. 60 ; #                            #
  7. 70 ; # thomas dachsel, 06.01.1988 #
  8. 80 ; #                            #
  9. 90 ; ##############################
  10. 100 +$c000
  11. 101 ;********************************
  12. 102 ;*                              *
  13. 103 ;* einsprungtabelle:            *
  14. 104 ;* ----------------             *
  15. 105 ;* diese tabelle enthaelt ein-  *
  16. 106 ;* sprungpunkte fuer alle zur   *
  17. 107 ;* verfuegung gestellten        *
  18. 108 ;* grafikroutinen.              *
  19. 109 ;*                              *
  20. 110 ;* routinen, die mehr parameter *
  21. 111 ;* benoetigen als cpu-register  *
  22. 112 ;* vorhanden sind, haben vor    *
  23. 113 ;* ihrem einsprungpunkt einen   *
  24. 114 ;* sog. aktivierungsblock.      *
  25. 115 ;*                              *
  26. 116 ;* die label r00, r03, r06, ... *
  27. 117 ;* dienen als hinweis auf die   *
  28. 118 ;* relative position der        *
  29. 119 ;* einsprungpunkte bzgl.        *
  30. 120 ;* der basis-adresse.           *
  31. 121 ;*                              *
  32. 122 ;********************************
  33. 200 r00 (NULL)page
  34. 210 r03 (NULL)design
  35. 220 r06 (NULL)off
  36. 230 r09 (NULL)inv
  37. 240 r0c (NULL)clear
  38. 250 r0f (NULL)color
  39. 260 r12 (NULL)setcol
  40. 270 r15 (NULL)cleardot
  41. 280 r18 (NULL)set
  42. 290 r1b (NULL)test
  43. 300 r1e (NULL)access
  44. 310 x0l then1
  45. 320 x0h then1
  46. 330 y0 then1
  47. 340 x1l then1
  48. 350 x1h then1
  49. 360 y1 then1
  50. 370 r27 (NULL)line
  51. 380 r2a (NULL)cline
  52. 390 fx0l then1
  53. 400 fx0h then1
  54. 410 fy0 then1
  55. 420 fx1l then1
  56. 430 fx1h then1
  57. 440 fy1 then1
  58. 450 r33 (NULL)frame
  59. 460 r36 (NULL)cframe
  60. 470 r39 (NULL)fill
  61. 480 tx then1
  62. 490 ty then1
  63. 500 expx then1
  64. 510 expy then1
  65. 520 case then1
  66. 530 r41 (NULL)text
  67. 540 rad then1
  68. 550 r45 (NULL)circle
  69. 560 r48 (NULL)ccircle
  70. 570 r4b (NULL)lines
  71. 580 r4e (NULL)clines
  72. 590 r51
  73. 600 ;--------------------------------
  74. 610 ; ab hier weitere eintrage
  75. 620 ;--------------------------------
  76. 1000 getram
  77. 1010  mid$#$7f;interrupts
  78. 1020  (NULL)$dc0d;aus
  79. 1030  mid$#$35;$a000 &
  80. 1040  (NULL)1;$e000 ram
  81. 1050 new
  82. 1060 getrom
  83. 1070  mid$#$37;$a000 &
  84. 1080  (NULL)1;$e000 rom
  85. 1090 new
  86. 1100 ;--------------------------------
  87. 1110 ; globale variablen
  88. 1120 ;--------------------------------
  89. 1130 tab(low=$14
  90. 1140 tab(high=$15
  91. 1150 tab(crp=$f9
  92. 1160 tab(hrp=$fb
  93. 1170 tab(hrb=$fd
  94. 1180 tab(hre=$fe
  95. 1190 tab(col=$ff
  96. 1200 ;--------------------------------
  97. 1210 ; grafik-seiten parameter
  98. 1220 ;--------------------------------
  99. 1230 pg1 fn$18,$78,$38,$38
  100. 1240 pg2 fn$04,$5c,$8c,$cc
  101. 1250 ;--------------------------------
  102. 1260 ; adress-tabellen
  103. 1270 ;--------------------------------
  104. 1280 tab1 fn0,$40,$80,$c0
  105. 1290  fn0,$40,$80,$c0
  106. 1300  fn0,$40,$80,$c0
  107. 1310  fn0,$40,$80,$c0
  108. 1320  fn0,$40,$80,$c0
  109. 1330  fn0,$40,$80,$c0,0
  110. 1340 tab2 fn0,1,2,3,5,6,7,8,$a,$b,$c,$d,$f
  111. 1350  fn$10,$11,$12,$14,$15,$16,$17,$19,$1a,$1b,$1c,$1e
  112. 1360 tab3 fn1,2,4,8,16,32,64,128
  113. 1370 ;--------------------------------
  114. 1380 ; 512 byte circle look-up tables
  115. 1390 ;--------------------------------
  116. 1400 lt1 fn$00,$01,$04,$09,$10,$19,$24,$31
  117. 1410  fn$40,$51,$64,$79,$90,$a9,$c4,$e1
  118. 1420  fn$00,$21,$44,$69,$90,$b9,$e4,$11
  119. 1430  fn$40,$71,$a4,$d9,$10,$49,$84,$c1
  120. 1440  fn$00,$41,$84,$c9,$10,$59,$a4,$f1
  121. 1450  fn$40,$91,$e4,$39,$90,$e9,$44,$a1
  122. 1460  fn$00,$61,$c4,$29,$90,$f9,$64,$d1
  123. 1470  fn$40,$b1,$24,$99,$10,$89,$04,$81
  124. 1480  fn$00,$81,$04,$89,$10,$99,$24,$b1
  125. 1490  fn$40,$d1,$64,$f9,$90,$29,$c4,$61
  126. 1500  fn$00,$a1,$44,$e9,$90,$39,$e4,$91
  127. 1510  fn$40,$f1,$a4,$59,$10,$c9,$84,$41
  128. 1520  fn$00,$c1,$84,$49,$10,$d9,$a4,$71
  129. 1530  fn$40,$11,$e4,$b9,$90,$69,$44,$21
  130. 1540  fn$00,$e1,$c4,$a9,$90,$79,$64,$51
  131. 1550  fn$40,$31,$24,$19,$10,$09,$04,$01
  132. 1560  fn$00,$01,$04,$09,$10,$19,$24,$31
  133. 1570  fn$40,$51,$64,$79,$90,$a9,$c4,$e1
  134. 1580  fn$00,$21,$44,$69,$90,$b9,$e4,$11
  135. 1590  fn$40,$71,$a4,$d9,$10,$49,$84,$c1
  136. 1600  fn$00,$41,$84,$c9,$10,$59,$a4,$f1
  137. 1610  fn$40,$91,$e4,$39,$90,$e9,$44,$a1
  138. 1620  fn$00,$61,$c4,$29,$90,$f9,$64,$d1
  139. 1630  fn$40,$b1,$24,$99,$10,$89,$04,$81
  140. 1640  fn$00,$81,$04,$89,$10,$99,$24,$b1
  141. 1650  fn$40,$d1,$64,$f9,$90,$29,$c4,$61
  142. 1660  fn$00,$a1,$44,$e9,$90,$39,$e4,$91
  143. 1670  fn$40,$f1,$a4,$59,$10,$c9,$84,$41
  144. 1680  fn$00,$c1,$84,$49,$10,$d9,$a4,$71
  145. 1690  fn$40,$11,$e4,$b9,$90,$69,$44,$21
  146. 1700  fn$00,$e1,$c4,$a9,$90,$79,$64,$51
  147. 1710  fn$40,$31,$24,$19,$10,$09,$04,$01
  148. 1720 lt2 then16
  149. 1730  fn1,1,1,1,1,1,1
  150. 1740  fn2,2,2,2,2,3,3,3,3
  151. 1750  fn4,4,4,4,5,5,5,5
  152. 1760  fn6,6,6,7,7,7,8,8,9,9,9
  153. 1770  fn$a,$a,$a,$b,$b,$c,$c
  154. 1780  fn$d,$d,$e,$e,$f,$f,$10
  155. 1790  fn$10,$11,$11,$12,$12,$13
  156. 1800  fn$13,$14,$14,$15,$15,$16
  157. 1810  fn$17,$17,$18,$19,$19,$1a
  158. 1820  fn$1a,$1b,$1c,$1c,$1d
  159. 1830  fn$1e,$1e,$1f,$20,$21
  160. 1840  fn$21,$22,$23,$24,$24
  161. 1850  fn$25,$26,$27,$27,$28
  162. 1860  fn$29,$2a,$2b,$2b,$2c
  163. 1870  fn$2d,$2e,$2f,$30,$31
  164. 1880  fn$31,$32,$33,$34,$35
  165. 1890  fn$36,$37,$38,$39,$3a
  166. 1900  fn$3b,$3c,$3d,$3e,$3f
  167. 1910  fn$40,$41,$42,$43,$44
  168. 1920  fn$45,$46,$47,$48,$49
  169. 1930  fn$4a,$4b,$4c,$4d,$4e
  170. 1940  fn$4f,$51,$52,$53,$54
  171. 1950  fn$55,$56,$57,$59,$5a
  172. 1960  fn$5b,$5c,$5d,$5f,$60
  173. 1970  fn$61,$62,$64,$65,$66
  174. 1980  fn$67,$69,$6a,$6b,$6c
  175. 1990  fn$6e,$6f,$70,$72,$73
  176. 2000  fn$74,$76,$77,$79,$7a
  177. 2010  fn$7b,$7d,$7e,$7f,$81
  178. 2020  fn$82,$84,$85,$87,$88
  179. 2030  fn$8a,$8b,$8d,$8e,$90
  180. 2040  fn$91,$93,$94,$96,$97
  181. 2050  fn$99,$9a,$9c,$9d,$9f
  182. 2060  fn$a0,$a2,$a4,$a5,$a7
  183. 2070  fn$a9,$aa,$ac,$ad,$af
  184. 2080  fn$b1,$b2,$b4,$b6,$b7
  185. 2090  fn$b9,$bb,$bd,$be,$c0
  186. 2100  fn$c2,$c4,$c5,$c7,$c9
  187. 2110  fn$cb,$cc,$ce,$d0,$d2
  188. 2120  fn$d4,$d5,$d7,$d9,$db
  189. 2130  fn$dd,$df,$e1,$e2,$e4
  190. 2140  fn$e6,$e8,$ea,$ec,$ee
  191. 2150  fn$f0,$f2,$f4,$f6,$f8
  192. 2160  fn$fa,$fc,$fe
  193. 3000 ;--------------------------------
  194. 3010 ;
  195. 3020 ; page
  196. 3030 ; ====
  197. 3040 ;
  198. 3050 ; x=0: grafikseite $2000
  199. 3060 ;      farbspeicher $0400
  200. 3070 ;
  201. 3080 ; x=1: grafikseite $6000
  202. 3090 ;      farbspeciher $5c00
  203. 3100 ;
  204. 3110 ; x=2: grafikseite $a000
  205. 3120 ;      farbspeicher $8c00
  206. 3130 ;
  207. 3140 ; x=3: grafikseite $e000
  208. 3150 ;      farbspeicher $cc00
  209. 3160 ;
  210. 3170 ; x>3: wird ignoriert
  211. 3180 ;
  212. 3190 ; der entsprechende 16 k - block
  213. 3200 ; wird angewaehlt durch setzen vom
  214. 3210 ; cia #1 port register a ($dd00).
  215. 3220 ; ausserdem werden die video-chip
  216. 3230 ; register und folgende zeiger
  217. 3240 ; gesetzt:
  218. 3250 ;
  219. 3260 ; bit-map: begin page -> hrb
  220. 3270 ;          end   page -> hre
  221. 3280 ; color:   begin page -> col
  222. 3290 ;
  223. 3300 ;--------------------------------
  224. 3310 page tan#4
  225. 3320  (NULL)accept
  226. 3330  (NULL)
  227. 3340 accept mid$#$3b
  228. 3350  (NULL)$d011
  229. 3360  mid$#$c8
  230. 3370  (NULL)$d016
  231. 3380  mid$pg1,x
  232. 3390  (NULL)$d018
  233. 3400  (NULL)
  234. 3410  left$#3
  235. 3420  (NULL)$dd00
  236. 3430 pointers (NULL)
  237. 3440  (NULL)
  238. 3450  (NULL)
  239. 3460  (NULL)
  240. 3470  (NULL)
  241. 3480  val#$20
  242. 3490  (NULL)hrb
  243. 3500  val#$20
  244. 3510  (NULL)hre
  245. 3520  mid$pg2,x
  246. 3530  (NULL)col
  247. 3540  (NULL)
  248. 3550 ;--------------------------------
  249. 3560 ; design
  250. 3570 ; ======
  251. 3580 ; waehlt nur die aktuelle
  252. 3590 ; grafikseite aus (ermoeglicht
  253. 3600 ; "verdecktes" zeichnen).
  254. 3610 ;--------------------------------
  255. 3620 design tan#4
  256. 3630  (NULL)pointers
  257. 3640  (NULL)
  258. 3650 ;--------------------------------
  259. 3660 ; off: grafik-seite aus
  260. 3670 ;--------------------------------
  261. 3680 off mid$#$1b
  262. 3690  (NULL)$d011
  263. 3700  mid$#$15
  264. 3710  (NULL)$d018
  265. 3720  mid$#3
  266. 3730  (NULL)$dd00
  267. 3740  (NULL)
  268. 3750 ;--------------------------------
  269. 3760 ; inv: grafik-seite invertieren
  270. 3770 ;--------------------------------
  271. 3780 inv ram
  272. 3790  len#0
  273. 3800  (NULL)hrp
  274. 3810  peekhrb
  275. 3820  (NULL)hrp+1
  276. 3830 ilp mid$(hrp),y
  277. 3840  left$#$ff
  278. 3850  (NULL)(hrp),y
  279. 3860  (NULL)
  280. 3870  (NULL)ilp
  281. 3880  right$hrp+1
  282. 3890  (NULL)
  283. 3900  tanhre
  284. 3910  (NULL)ilp
  285. 3920  rom
  286. 3930  (NULL)
  287. 3940 ;--------------------------------
  288. 3950 ; clear: grafikseite loeschen
  289. 3960 ;--------------------------------
  290. 3970 clear mid$#0
  291. 3980  (NULL)hrp
  292. 3990  peekhrb
  293. 4000  (NULL)hrp+1
  294. 4010  (NULL)
  295. 4020 clp (NULL)(hrp),y
  296. 4030  (NULL)
  297. 4040  (NULL)clp
  298. 4050  right$hrp+1
  299. 4060  (NULL)
  300. 4070  tanhre
  301. 4080  (NULL)clp
  302. 4090  (NULL)
  303. 4100 ;--------------------------------
  304. 4110 ; color: fuellt gesamten farb-
  305. 4120 ; speicher mit inhalt des akkus
  306. 4130 ;
  307. 4140 ; high 4 bits :  color of 1-bits
  308. 4150 ;  low 4 bits :  color of 0-bits
  309. 4160 ;--------------------------------
  310. 4170 color len#0
  311. 4180  (NULL)hrp
  312. 4190  peekcol
  313. 4200  (NULL)hrp+1
  314. 4210  peek#3
  315. 4220 colset (NULL)(hrp),y
  316. 4230  (NULL)
  317. 4240  (NULL)colset
  318. 4250  right$hrp+1
  319. 4260  (NULL)
  320. 4270  (NULL)colset
  321. 4280  (NULL)
  322. 4290 ;--------------------------------
  323. 4300 ; setcol: setzt farbe fuer 8 * 8
  324. 4310 ;         bit-block
  325. 4320 ;
  326. 4330 ;       a = zeile  (0-24)
  327. 4340 ;       x = spalte (0-39)
  328. 4350 ;       y = farbe  (0-15)
  329. 4360 ;--------------------------------
  330. 4370 setcol tan#40;x < 40 !
  331. 4380  (NULL)nocol
  332. 4390  str$#25;a < 25 !
  333. 4400  (NULL)nocol+1
  334. 4410 nocol (NULL)
  335. 4420  (NULL);a := a * 8
  336. 4430  (NULL)
  337. 4440  (NULL)
  338. 4450  (NULL)
  339. 4460  (NULL)hrp
  340. 4470  mid$#0
  341. 4480  (NULL)hrp+1
  342. 4490  (NULL)hrp
  343. 4500  (NULL)hrp+1
  344. 4510  (NULL)hrp;hrp =
  345. 4520  (NULL)hrp+1; a * 32
  346. 4530  (NULL)
  347. 4540  (NULL);hrp :=
  348. 4550  valhrp;hrp + a*8
  349. 4560  (NULL)hrp
  350. 4570  mid$#0;->
  351. 4580  valhrp+1;hrp = a*40
  352. 4590  (NULL)hrp+1
  353. 4600  (NULL);c = 0 !
  354. 4610  valhrp
  355. 4620  (NULL)hrp;hrp:=hrp+x
  356. 4630  mid$hrp+1
  357. 4640  valcol;add color
  358. 4650  (NULL)hrp+1;ram base
  359. 4660  peek#0;address
  360. 4670  mid$(hrp,x)
  361. 4680  asc#$f;isolate
  362. 4690  (NULL)(hrp,x);background
  363. 4700  (NULL);color
  364. 4710  (NULL)
  365. 4720  (NULL);high 4 bit
  366. 4730  (NULL);pen color
  367. 4740  (NULL)
  368. 4750  (NULL)(hrp,x);set new
  369. 4760  (NULL)(hrp,x);color
  370. 4770  (NULL)
  371. 5000 ;--------------------------------
  372. 5010 ;
  373. 5020 ;  access single dot in bit-map
  374. 5030 ;  ============================
  375. 5040 ;
  376. 5050 ;  koordinaten werden gesetzt
  377. 5060 ;  nach akku, x, y registern:
  378. 5070 ;
  379. 5080 ;  x-achse: (a/x)    y-achse: y
  380. 5090 ;
  381. 5100 ;  die zulaessigen werte sind:
  382. 5110 ;
  383. 5120 ;     0 <= (x-achse) <= 319
  384. 5130 ;     0 <= (y-achse) <= 199
  385. 5140 ;
  386. 5150 ; andere werte werden ignoriert -
  387. 5160 ; die routine wird ohne neben-
  388. 5170 ; wirkung verlassen
  389. 5180 ;
  390. 5190 ; die auszufuehrende operation ist
  391. 5200 ; in $0002 kodiert:
  392. 5210 ;
  393. 5220 ;    ($0002) = 0     => clear dot
  394. 5230 ; msb($0002) not set => set   dot
  395. 5240 ; msb($0002) set     => test  dot
  396. 5250 ;
  397. 5260 ; "access" wird aufgerufen, falls
  398. 5270 ; $0002 schon gesetzt wurde.
  399. 5280 ;
  400. 5290 ; cleardot, set und test setzen
  401. 5300 ; $0002 vor aufruf von access.
  402. 5310 ;
  403. 5320 ; "test dot"   c=0 : dot not set
  404. 5330 ;  liefert:    c=1 : dot set
  405. 5340 ;
  406. 5350 ;--------------------------------
  407. 5360 cleardot (NULL)
  408. 5370  mid$#0
  409. 5380  (NULL)cont
  410. 5390 set (NULL)
  411. 5400  mid$#1
  412. 5410  (NULL)cont
  413. 5420 test (NULL)
  414. 5430  mid$#$ff
  415. 5440 cont (NULL)2
  416. 5450  (NULL)
  417. 5460 ;
  418. 5470 ;   *** coordinate check ***
  419. 5480 ;
  420. 5490 access atn#$c8
  421. 5500  (NULL)discard
  422. 5510  tan#1
  423. 5520  (NULL)acceptdot
  424. 5530  (NULL)discard
  425. 5540  str$#$40
  426. 5550  (NULL)acceptdot
  427. 5560 discard (NULL)
  428. 5570 ;
  429. 5580 ;*** compute bit-map pointer ***
  430. 5590 ;
  431. 5600 acceptdot (NULL)
  432. 5610  asc#$f8
  433. 5620  (NULL)hrp
  434. 5630  (NULL)
  435. 5640  (NULL)
  436. 5650  valhrb
  437. 5660  (NULL)hrp+1
  438. 5670  (NULL)
  439. 5680  (NULL)
  440. 5690  (NULL)
  441. 5700  (NULL)
  442. 5710  (NULL);0<= x <=25
  443. 5720  mid$tab1,x
  444. 5730  (NULL)
  445. 5740  valhrp
  446. 5750  (NULL)hrp
  447. 5760  mid$tab2,x
  448. 5770  valhrp+1
  449. 5780  (NULL)hrp+1
  450. 5790  (NULL)
  451. 5800  asc#7
  452. 5810  valhrp
  453. 5820  (NULL)hrp
  454. 5830  ram
  455. 5840  (NULL)
  456. 5850  asc#7
  457. 5860  left$#7;a := 7-a
  458. 5870  (NULL)
  459. 5880  mid$tab3,x;0 <=x<= 7
  460. 5890 ;********************************
  461. 5900 ;*                              *
  462. 5910 ;* accu now contains bit-mask . *
  463. 5920 ;* hrp points to bit-map memory *
  464. 5930 ;* to the byte containing the   *
  465. 5940 ;* actual dot.                  *
  466. 5950 ;*                              *
  467. 5960 ;* operation subject to $0002   *
  468. 5970 ;* contents is now executed .   *
  469. 5980 ;*                              *
  470. 5990 ;********************************
  471. 6000  len#0
  472. 6010  peek2
  473. 6020  (NULL)testdot
  474. 6030  (NULL)setdot
  475. 6040  asc(hrp),y
  476. 6050  left$(hrp),y
  477. 6060  (NULL)(hrp),y
  478. 6070  rom
  479. 6080  (NULL)
  480. 6090 setdot (NULL)(hrp),y
  481. 6100  (NULL)(hrp),y
  482. 6110  rom
  483. 6120  (NULL)
  484. 6130 testdot asc(hrp),y
  485. 6140  (NULL)notset
  486. 6150  rom
  487. 6160  (NULL)
  488. 6170  (NULL)
  489. 6180 notset rom
  490. 6190  (NULL)
  491. 6200  (NULL)
  492. 6210 ;--------------------------------
  493. 6220 ;
  494. 6230 ;       draw/clear a line
  495. 6240 ;       =================
  496. 6250 ;
  497. 6260 ; diese routine zeichnet bzw.
  498. 6270 ; loescht eine linie von den
  499. 6280 ; koordinaten (x0,y0) zu (x1,y1).
  500. 6290 ; line zeichnet, cline loescht
  501. 6300 ; die linie.
  502. 6310 ;
  503. 6320 ; y0 und y1 werden in einem byte
  504. 6330 ; gespeichert.
  505. 6340 ;
  506. 6350 ; x0 und x1 werden jeweils in
  507. 6360 ; zwei bytes gespeichert mit
  508. 6370 ;
  509. 6380 ; x0l fuer  low byte
  510. 6390 ;                     von x0
  511. 6400 ; x0h fuer high byte
  512. 6410 ;
  513. 6420 ; x1l fuer  low byte
  514. 6430 ;                     von x1
  515. 6440 ; x1h fuer high byte
  516. 6450 ;
  517. 6460 ; a, x, y werden ignoriert.
  518. 6470 ;
  519. 6480 ;
  520. 6490 ; die koordinaten werden nicht
  521. 6500 ; auf bereichsueberschreitung
  522. 6510 ; geprueft. deshalb koennen
  523. 6520 ; linien auch ueber den bild-
  524. 6530 ; schirmrand hinaus reichen.
  525. 6540 ;
  526. 6550 ;   das hat jedoch keine
  527. 6560 ;   schaedlichen auswirkungen, da
  528. 6570 ;   schon "access" auf bereichs-
  529. 6580 ;   ueberschreitung prueft.
  530. 6590 ;
  531. 6600 ; nach ausfuehrung von "line"
  532. 6610 ; ist (x0,y0) gleich (x1,y1).
  533. 6620 ; die koordinaten muessen daher
  534. 6630 ; bei jedem aufruf neu gesetzt
  535. 6640 ; werden.
  536. 6650 ;--------------------------------
  537. 6660 dx then1;internal
  538. 6670 dy then1;parameter
  539. 6680 diffxl then1;memory
  540. 6690 diffxh then1;area
  541. 6700 diffy then1
  542. 6710 dc then1
  543. 6720 dh then1
  544. 6730 dm then1
  545. 6740 dl then1
  546. 6750 qh then1
  547. 6760 qm then1
  548. 6770 ql then1
  549. 6780 delta_h then1
  550. 6790 delta_m then1
  551. 6800 delta_l then1
  552. 6810 line mid$#1
  553. 6820  (NULL)*+4
  554. 6830 cline mid$#0
  555. 6840  (NULL)2
  556. 6850 accessline
  557. 6860 ;********************************
  558. 6870 ;*                              *
  559. 6880 ;* 1. compute dx and dy         *
  560. 6890 ;* --------------------         *
  561. 6900 ;*                              *
  562. 6910 ;* dx and dy are used to deter- *
  563. 6920 ;* mine in which direction the  *
  564. 6930 ;* line is to be drawn.         *
  565. 6940 ;*                              *
  566. 6950 ;* dx = -1  indicates           *
  567. 6960 ;*          x coord. decrements *
  568. 6970 ;*                              *
  569. 6980 ;* dx =  1  indicates           *
  570. 6990 ;*          x coord. increments *
  571. 7000 ;*                              *
  572. 7010 ;* dx =  0  indicates there is  *
  573. 7020 ;*          no x coord. change  *
  574. 7030 ;*                              *
  575. 7040 ;* values of dy are analogous.  *
  576. 7050 ;*                              *
  577. 7060 ;********************************
  578. 7070  peek#$ff;compute dx
  579. 7080  mid$x1h
  580. 7090  str$x0h
  581. 7100  (NULL)txl
  582. 7110  (NULL)dxp
  583. 7120  (NULL)dxn
  584. 7130 txl mid$x1l;test x low
  585. 7140  str$x0l
  586. 7150  (NULL)dxn
  587. 7160  (NULL)dxz
  588. 7170 dxp (NULL);dx =  1
  589. 7180 dxz (NULL);dx =  0
  590. 7190 dxn (NULL)dx;dx = -1
  591. 7200 ;================================
  592. 7210  peek#$ff;compute dy
  593. 7220  mid$y1
  594. 7230  str$y0
  595. 7240  (NULL)dyn
  596. 7250  (NULL)dyz
  597. 7260  (NULL);dy =  1
  598. 7270 dyz (NULL);dy =  0
  599. 7280 dyn (NULL)dy;dy = -1
  600. 7290 ;================================
  601. 7300  (NULL)equal;if dy = 0
  602. 7310  mid$dx;or dx = 0
  603. 7320  (NULL)equal;goto equal
  604. 7330 ;********************************
  605. 7340 ;*                              *
  606. 7350 ;* 2.  compute x and y          *
  607. 7360 ;*     coordinate differences   *
  608. 7370 ;* --------------------------   *
  609. 7380 ;*                              *
  610. 7390 ;* this is effected by normal   *
  611. 7400 ;* subtraction and subsequent   *
  612. 7410 ;* 2-complement formation, if   *
  613. 7420 ;* result is negative.          *
  614. 7430 ;*                              *
  615. 7440 ;********************************
  616. 7450 cdx mid$x1l;diff. x
  617. 7460  (NULL)
  618. 7470  (NULL)x0l
  619. 7480  (NULL)diffxl
  620. 7490  mid$x1h
  621. 7500  (NULL)x0h
  622. 7510  (NULL)diffxh
  623. 7520  mid$dx
  624. 7530  (NULL)cdy
  625. 7540  mid$diffxl;if dx= -1
  626. 7550  left$#$ff
  627. 7560  (NULL);compute
  628. 7570  val#1
  629. 7580  (NULL)diffxl;2-compl.
  630. 7590  mid$diffxh
  631. 7600  left$#$ff
  632. 7610  val#0
  633. 7620  (NULL)diffxh
  634. 7630 ;================================
  635. 7640 cdy mid$y1;diff. y
  636. 7650  (NULL)
  637. 7660  (NULL)y0
  638. 7670  (NULL)diffy
  639. 7680  mid$dy
  640. 7690  (NULL)incdiff;if dy = -1
  641. 7700  mid$diffy
  642. 7710  left$#$ff
  643. 7720  (NULL)
  644. 7730  val#1;2-compl.
  645. 7740  (NULL)diffy
  646. 7750 ;================================
  647. 7760 incdiff right$diffxl;increment
  648. 7770  (NULL)incdiffy;difference
  649. 7780  right$diffxh;by 1
  650. 7790 incdiffy right$diffy
  651. 7800 ;================================
  652. 7810  mid$diffxh
  653. 7820  (NULL)xway
  654. 7830  mid$diffxl
  655. 7840  str$diffy
  656. 7850  (NULL)xway
  657. 7860  (NULL)yway
  658. 7870 ;================================
  659. 7880 equal mid$x0l;"straight"
  660. 7890  peekx0h;lines are
  661. 7900  leny0;drawn here
  662. 7910  (NULL)access
  663. 7920  mid$y0
  664. 7930  str$y1
  665. 7940  (NULL)conteq
  666. 7950  mid$x0h
  667. 7960  str$x1h
  668. 7970  (NULL)conteq
  669. 7980  mid$x0l
  670. 7990  str$x1l
  671. 8000  (NULL)conteq
  672. 8010  (NULL)
  673. 8020 conteq mid$y0
  674. 8030  (NULL)
  675. 8040  valdy
  676. 8050  (NULL)y0
  677. 8060  mid$dx
  678. 8070  (NULL)equal
  679. 8080  (NULL)downxeq
  680. 8090  (NULL)
  681. 8100  valx0l
  682. 8110  (NULL)x0l
  683. 8120  mid$x0h
  684. 8130  val#0
  685. 8140  (NULL)x0h
  686. 8150  (NULL)equal
  687. 8160 downxeq chr$x0l
  688. 8170  mid$x0l
  689. 8180  str$#$ff
  690. 8190  (NULL)equal
  691. 8200  chr$x0h
  692. 8210  (NULL)equal
  693. 8220 ;********************************
  694. 8230 ;*                              *
  695. 8240 ;* 3. divide diff. x by diff. y *
  696. 8250 ;* ---------------------------- *
  697. 8260 ;*                              *
  698. 8270 ;* this is a 24/8 bit division. *
  699. 8280 ;*                              *
  700. 8290 ;* dc/dh/dm/dl is the dividend, *
  701. 8300 ;* diffy       is the divisor,  *
  702. 8310 ;* qh/qm/ql    is the quotient. *
  703. 8320 ;*                              *
  704. 8330 ;********************************
  705. 8340 xway peek#0
  706. 8350  (NULL)dl
  707. 8360  mid$diffxl
  708. 8370  (NULL)dm
  709. 8380  mid$diffxh
  710. 8390  (NULL)dh
  711. 8400  (NULL)dc
  712. 8410  peek#24
  713. 8420 divloop mid$dh
  714. 8430  (NULL)
  715. 8440  (NULL)diffy
  716. 8450  (NULL)
  717. 8460  mid$dc
  718. 8470  (NULL)#0
  719. 8480  (NULL)rotleft
  720. 8490  (NULL)dh
  721. 8500  (NULL)dc
  722. 8510  (NULL)
  723. 8520  fn$24
  724. 8530 rotleft (NULL)
  725. 8540  (NULL)ql;rotate c
  726. 8550  (NULL)qm;left into
  727. 8560  (NULL)qh;quotient
  728. 8570  (NULL)dl
  729. 8580  (NULL)dm;rotate
  730. 8590  (NULL)dh;dividend
  731. 8600  (NULL)dc;left
  732. 8610  (NULL)
  733. 8620  (NULL)divloop
  734. 8630 ;================================
  735. 8640  mid$qh
  736. 8650  (NULL)delta_h
  737. 8660  mid$qm
  738. 8670  (NULL)delta_m
  739. 8680  mid$ql
  740. 8690  (NULL)delta_l
  741. 8700 ;================================
  742. 8710 xloop mid$x0h
  743. 8720  str$x1h
  744. 8730  (NULL)xcont
  745. 8740  mid$x0l
  746. 8750  str$x1l;if x0=x1
  747. 8760  (NULL)xcont;then exit
  748. 8770  (NULL)
  749. 8780 ;================================
  750. 8790 xcont mid$x0l
  751. 8800  peekx0h
  752. 8810  leny0
  753. 8820  (NULL)access
  754. 8830  mid$dx
  755. 8840  (NULL)xdown
  756. 8850  right$x0l
  757. 8860  (NULL)sety
  758. 8870  right$x0h
  759. 8880  (NULL)sety
  760. 8890 xdown chr$x0l
  761. 8900  mid$x0l
  762. 8910  str$#$ff
  763. 8920  (NULL)sety
  764. 8930  chr$x0h
  765. 8940 ;================================
  766. 8950 sety chr$delta_h
  767. 8960  (NULL)xloop
  768. 8970  mid$y0
  769. 8980  (NULL)
  770. 8990  valdy
  771. 9000  (NULL)y0
  772. 9010  (NULL)
  773. 9020  mid$delta_l
  774. 9030  valql
  775. 9040  (NULL)delta_l
  776. 9050  mid$delta_m
  777. 9060  valqm
  778. 9070  (NULL)delta_m
  779. 9080  mid$qh
  780. 9090  val#0
  781. 9100  (NULL)delta_h
  782. 9110  (NULL)xloop
  783. 9120 ;********************************
  784. 9130 ;*                              *
  785. 9140 ;* 4. divide diff. y by diff. x *
  786. 9150 ;* ---------------------------- *
  787. 9160 ;*                              *
  788. 9170 ;* this is a 24/8 bit division. *
  789. 9180 ;*                              *
  790. 9190 ;* dc/dh/dm/dl is the dividend, *
  791. 9200 ;* diffxl      is the divisor,  *
  792. 9210 ;* qh/qm/ql    is the quotient. *
  793. 9220 ;*                              *
  794. 9230 ;********************************
  795. 9240 yway peek#0
  796. 9250  (NULL)dl
  797. 9260  mid$diffy
  798. 9270  (NULL)dm
  799. 9280  (NULL)dh
  800. 9290  (NULL)dc
  801. 9300  peek#24
  802. 9310 divyloop mid$dh
  803. 9320  (NULL)
  804. 9330  (NULL)diffxl
  805. 9340  (NULL)
  806. 9350  mid$dc
  807. 9360  (NULL)#0
  808. 9370  (NULL)rotlefty
  809. 9380  (NULL)dh
  810. 9390  (NULL)dc
  811. 9400  (NULL)
  812. 9410  fn$24
  813. 9420 rotlefty (NULL)
  814. 9430  (NULL)ql;rotate c
  815. 9440  (NULL)qm;left into
  816. 9450  (NULL)qh;quotient
  817. 9460  (NULL)dl
  818. 9470  (NULL)dm;rotate
  819. 9480  (NULL)dh;dividend
  820. 9490  (NULL)dc;left
  821. 9500  (NULL)
  822. 9510  (NULL)divyloop
  823. 9520 ;================================
  824. 9530  mid$qh
  825. 9540  (NULL)delta_h
  826. 9550  mid$qm
  827. 9560  (NULL)delta_m
  828. 9570  mid$ql
  829. 9580  (NULL)delta_l
  830. 9590 ;================================
  831. 9600 yloop mid$y0
  832. 9610  str$y1;if y0=y1
  833. 9620  (NULL)ycont;then exit
  834. 9630  (NULL)
  835. 9640 ;================================
  836. 9650 ycont mid$x0l
  837. 9660  peekx0h
  838. 9670  leny0
  839. 9680  (NULL)access
  840. 9690  mid$y0
  841. 9700  (NULL)
  842. 9710  valdy
  843. 9720  (NULL)y0
  844. 9730 setx chr$delta_h
  845. 9740  (NULL)yloop
  846. 9750  mid$dx
  847. 9760  (NULL)xdowny
  848. 9770  right$x0l
  849. 9780  (NULL)getdelta
  850. 9790  right$x0h
  851. 9800  (NULL)getdelta
  852. 9810 xdowny chr$x0l
  853. 9820  mid$x0l
  854. 9830  str$#$ff
  855. 9840  (NULL)getdelta
  856. 9850  chr$x0h
  857. 9860 ;================================
  858. 9870 getdelta (NULL)
  859. 9880  mid$delta_l
  860. 9890  valql
  861. 9900  (NULL)delta_l
  862. 9910  mid$delta_m
  863. 9920  valqm
  864. 9930  (NULL)delta_m
  865. 9940  mid$qh
  866. 9950  val#0
  867. 9960  (NULL)delta_h
  868. 9970  (NULL)yloop
  869. 10000 ;--------------------------------
  870. 10010 ;
  871. 10020 ;      draw/clear a frame
  872. 10030 ;      ==================
  873. 10040 ;
  874. 10050 ; frame zeichnet einen rahmen.
  875. 10060 ; cframe loescht diesen rahmen.
  876. 10070 ;
  877. 10080 ; (fx0,fy0) enthaelt die linke
  878. 10090 ; obere ecke and (fx1,fy1)
  879. 10100 ; die rechte untere ecke
  880. 10110 ; (oder umgekehrt).
  881. 10120 ;
  882. 10130 ;--------------------------------
  883. 10140 tab(px0l=x0l
  884. 10150 tab(px0h=x0h
  885. 10160 tab(px1l=x1l
  886. 10170 tab(px1h=x1h
  887. 10180 tab(py0=y0
  888. 10190 tab(py1=y1
  889. 10200 getlcclosexcl,xch,yc
  890. 10210  mid$xcl
  891. 10220  peekxch
  892. 10230  lenyc
  893. 10240 new
  894. 10250 getscclosexcl,xch,yc
  895. 10260  (NULL)xcl
  896. 10270  (NULL)xch
  897. 10280  (NULL)yc
  898. 10290 new
  899. 10300 getxf0closesxl,sxh,sy
  900. 10310  lcclosesxl,sxh,sy
  901. 10320  scclosepx0l,px0h,py0
  902. 10330 new
  903. 10340 getxf1closesxl,sxh,sy
  904. 10350  lcclosesxl,sxh,sy
  905. 10360  scclosepx1l,px1h,py1
  906. 10370 new
  907. 10380 frame mid$#1
  908. 10390  (NULL)*+4
  909. 10400 cframe mid$#0
  910. 10410  (NULL)2
  911. 10420  xf0closefx0l,fx0h,fy0
  912. 10430  xf1closefx1l,fx1h,fy0
  913. 10440  (NULL)accessline
  914. 10450  xf0closefx1l,fx1h,fy1
  915. 10460  (NULL)accessline
  916. 10470  xf0closefx0l,fx0h,fy0
  917. 10480  xf1closefx0l,fx0h,fy1
  918. 10490  (NULL)accessline
  919. 10500  xf0closefx1l,fx1h,fy1
  920. 10510  (NULL)accessline
  921. 10520 ;--------------------------------
  922. 10530 ;
  923. 10540 ;         fill a frame
  924. 10550 ;         ============
  925. 10560 ;
  926. 10570 ; fill fueltt einen bereich der
  927. 10580 ; grafikseite, der von einem
  928. 10590 ; rahmen beschraenkt ist.
  929. 10600 ;
  930. 10610 ; ohne begrenzung wird jeweils
  931. 10620 ; bis zum bildschirmrand auf-
  932. 10630 ; gefuellt.
  933. 10640 ;
  934. 10650 ; der punkt, an dem die fuell-
  935. 10660 ; operationen beginnt, wird mit
  936. 10670 ; a,x,y registern wie bei "set"
  937. 10680 ; festgelegt.
  938. 10690 ;
  939. 10700 ; ist dieser punkt bereits ge-
  940. 10710 ; setzt, stoppt fill sofort.
  941. 10720 ;
  942. 10730 ; warnung: in dieser version
  943. 10740 ; werden nur rechteckige rahmen
  944. 10750 ; vollstaendig ausgefuellt.
  945. 10760 ; in anderen faellen koennen
  946. 10770 ; mehrere "fills" notwendig sein.
  947. 10780 ;
  948. 10790 ;--------------------------------
  949. 10800 sxl then1
  950. 10810 sxh then1
  951. 10820 sy then1
  952. 10830 cxl then1
  953. 10840 cxh then1
  954. 10850 cy then1
  955. 10860 getinwcloseword
  956. 10870  right$word
  957. 10880  (NULL)end
  958. 10890  right$word+1
  959. 10900 end
  960. 10910 new
  961. 10920 getdcwcloseword
  962. 10930  chr$word
  963. 10940  mid$word
  964. 10950  str$#$ff
  965. 10960  (NULL)end
  966. 10970  chr$word+1
  967. 10980 end
  968. 10990 new
  969. 11000 fill scclosesxl,sxh,sy
  970. 11010  (NULL)test
  971. 11020  (NULL)begin
  972. 11030  (NULL)
  973. 11040 begin lcclosesxl,sxh,sy
  974. 11050 lineup scclosecxl,cxh,cy
  975. 11060  (NULL)test
  976. 11070  (NULL)setup
  977. 11080  (NULL)down
  978. 11090 setup lcclosecxl,cxh,cy
  979. 11100  (NULL)set
  980. 11110  mid$cxl
  981. 11120  (NULL)decrx;hit
  982. 11130  mid$cxh;left
  983. 11140  (NULL)contr;border ?
  984. 11150 decrx dcwclosecxl
  985. 11160  lcclosecxl,cxh,cy
  986. 11170  (NULL)test
  987. 11180  (NULL)setup
  988. 11190 contr mid$sxl;start
  989. 11200  peeksxh;x-coord.
  990. 11210  (NULL)cxl
  991. 11220  (NULL)cxh
  992. 11230 walkr mid$cxh
  993. 11240  (NULL)incrx
  994. 11250  mid$cxl;hit
  995. 11260  str$#$40;right
  996. 11270  (NULL)contup;border ?
  997. 11280 incrx inwclosecxl
  998. 11290  lcclosecxl,cxh,cy
  999. 11300  (NULL)test
  1000. 11310  (NULL)contup
  1001. 11320  lcclosecxl,cxh,cy
  1002. 11330  (NULL)set
  1003. 11340  (NULL)walkr
  1004. 11350 contup mid$sxl
  1005. 11360  peeksxh
  1006. 11370  (NULL)cxl
  1007. 11380  (NULL)cxh
  1008. 11390  lcclosecxl,cxh,cy
  1009. 11400  (NULL)
  1010. 11410  atn#$ff
  1011. 11420  (NULL)down
  1012. 11430  (NULL)lineup
  1013. 11440 down lcclosesxl,sxh,sy
  1014. 11450  scclosecxl,cxh,cy
  1015. 11460 bottom (NULL)
  1016. 11470  atn#200
  1017. 11480  (NULL)checkdown
  1018. 11490  (NULL)
  1019. 11500 checkdown (NULL)cy
  1020. 11510  (NULL)test
  1021. 11520  (NULL)setdown
  1022. 11530  (NULL)
  1023. 11540 setdown lcclosecxl,cxh,cy
  1024. 11550  (NULL)set
  1025. 11560  mid$cxl
  1026. 11570  (NULL)decrxd;hit
  1027. 11580  mid$cxh;left
  1028. 11590  (NULL)contrd;border ?
  1029. 11600 decrxd dcwclosecxl
  1030. 11610  lcclosecxl,cxh,cy
  1031. 11620  (NULL)test
  1032. 11630  (NULL)setdown
  1033. 11640 contrd mid$sxl;start
  1034. 11650  peeksxh;x-coord.
  1035. 11660  (NULL)cxl
  1036. 11670  (NULL)cxh
  1037. 11680 walkrd mid$cxh
  1038. 11690  (NULL)incrxd
  1039. 11700  mid$cxl;hit
  1040. 11710  str$#$40;right
  1041. 11720  (NULL)contdown;border ?
  1042. 11730 incrxd inwclosecxl
  1043. 11740  lcclosecxl,cxh,cy
  1044. 11750  (NULL)test
  1045. 11760  (NULL)contdown
  1046. 11770  lcclosecxl,cxh,cy
  1047. 11780  (NULL)set
  1048. 11790  (NULL)walkrd
  1049. 11800 contdown mid$sxl
  1050. 11810  peeksxh
  1051. 11820  (NULL)cxl
  1052. 11830  (NULL)cxh
  1053. 11840  lency
  1054. 11850  (NULL)bottom
  1055. 11860 ;--------------------------------
  1056. 11870 ;
  1057. 11880 ;             text
  1058. 11890 ;             ====
  1059. 11900 ;
  1060. 11910 ; zeigt ascii text auf der
  1061. 11920 ; aktuellen grafikseite an.
  1062. 11930 ;
  1063. 11940 ; die adresse des anzuzeigenden
  1064. 11950 ; textes wird in die register
  1065. 11960 ; (a/y) (low/high) geladen;
  1066. 11970 ; die textfarbe ins x register.
  1067. 11980 ; ist x>128, wird keine neue
  1068. 11990 ; farbe gesetzt.
  1069. 12000 ; die spalte/zeile, an der der
  1070. 12010 ; erste buchstabe angezeigt wird,
  1071. 12020 ; wird bestimmmt durch
  1072. 12030 ;
  1073. 12040 ;  tx  (spalte) : 0 <= tx <= 39
  1074. 12050 ;  ty  (zeile)  : 0 <= tx <= 24
  1075. 12060 ;
  1076. 12070 ;  bei anderen werten stoppt
  1077. 12080 ;  " text " sofort.
  1078. 12090 ;
  1079. 12100 ; expx bestimmt die horizontale
  1080. 12110 ; ausdehnung der buchstaben. es
  1081. 12120 ; werden nur die beiden lsb's
  1082. 12130 ; betrachtet. die werte 0,1,2,3
  1083. 12140 ; bestimmen die ausdehnung in x-
  1084. 12150 ; richtung.
  1085. 12160 ; expy bestimmt die vertikale
  1086. 12170 ; ausdehnung der buchstaben.
  1087. 12180 ; die werte entsprechen denen von
  1088. 12190 ; expx.
  1089. 12200 ; case gibt an, welcher zeichen-
  1090. 12210 ; satz verwendet wird
  1091. 12220 ; (nur das lsb wird betrachtet):
  1092. 12230 ;
  1093. 12240 ;      case=0 :  upper case
  1094. 12250 ;
  1095. 12260 ;      case=1 :  lower case
  1096. 12270 ;
  1097. 12280 ; wird bei der anzeige des textes
  1098. 12290 ; das zeilenende erreicht, haelt
  1099. 12300 ; die routine, und der rest des
  1100. 12310 ; textes wird ignoriert.
  1101. 12320 ;
  1102. 12330 ; das ende des textes wird durch
  1103. 12340 ; ein null byte (hex 00) hinter
  1104. 12350 ; dem letzten zeichen markiert.
  1105. 12360 ;
  1106. 12370 ;--------------------------------
  1107. 12380 matbuf then8
  1108. 12390 bxl then1
  1109. 12400 bxh then1
  1110. 12410 xxl then1
  1111. 12420 xxh then1
  1112. 12430 xy then1
  1113. 12440 xxc then1
  1114. 12450 xyc then1
  1115. 12460 textcol then1
  1116. 12470 ;================================
  1117. 12480 text (NULL)readchar+1
  1118. 12490  (NULL)readchar+2
  1119. 12500  (NULL)textcol
  1120. 12510 ;================================
  1121. 12520 textloop mid$tx;enough
  1122. 12530  str$#40;room left?
  1123. 12540  (NULL)terminate
  1124. 12550  mid$ty
  1125. 12560  str$#25
  1126. 12570  (NULL)terminate
  1127. 12580 readchar mid$$ffff;text adr.
  1128. 12590  (NULL)conttext
  1129. 12600 terminate mid$#0;reset
  1130. 12610  (NULL)2;loc. 2 !
  1131. 12620  (NULL)
  1132. 12630 ;================================
  1133. 12640 conttext inwclosereadchar+1
  1134. 12650  lentextcol
  1135. 12660  (NULL)colorchar
  1136. 12670  str$#" "
  1137. 12680  (NULL)convchar+1
  1138. 12690  (NULL)nextcol
  1139. 12700 colorchar (NULL)
  1140. 12710  mid$#0
  1141. 12720  (NULL)low
  1142. 12730  (NULL)high
  1143. 12740 tcl lentextcol
  1144. 12750  mid$tx
  1145. 12760  (NULL)
  1146. 12770  vallow;x offset
  1147. 12780  (NULL)
  1148. 12790  mid$ty
  1149. 12800  (NULL)
  1150. 12810  valhigh;y offset
  1151. 12820  (NULL)setcol
  1152. 12830  mid$low
  1153. 12840  str$expx
  1154. 12850  (NULL)tcc
  1155. 12860  right$low
  1156. 12870  (NULL)tcl
  1157. 12880 tcc mid$high
  1158. 12890  str$expy
  1159. 12900  (NULL)convchar
  1160. 12910  mid$#0
  1161. 12920  (NULL)low
  1162. 12930  right$high
  1163. 12940  (NULL)tcl
  1164. 12950 ;================================
  1165. 12960 convchar (NULL)
  1166. 12970  str$#$40
  1167. 12980  (NULL)tl
  1168. 12990  str$#$60;convert
  1169. 13000  (NULL)cv1;ascii
  1170. 13010  str$#$80;to
  1171. 13020  (NULL)cv2;screen
  1172. 13030  str$#$c0;code
  1173. 13040  (NULL)cv1
  1174. 13050 cv2 (NULL)
  1175. 13060  (NULL)#$40
  1176. 13070 cv1 (NULL)
  1177. 13080  (NULL)#$40
  1178. 13090 tl (NULL)crp;init
  1179. 13100  mid$#0;char-rom
  1180. 13110  (NULL)crp+1;pointer
  1181. 13120  peek#3
  1182. 13130 mult8 (NULL)crp;multiply
  1183. 13140  (NULL)crp+1;"crp" by 8
  1184. 13150  (NULL)
  1185. 13160  (NULL)mult8
  1186. 13170  mid$case;add base
  1187. 13180  asc#1;address
  1188. 13190  (NULL)
  1189. 13200  (NULL);character
  1190. 13210  (NULL);matrix is
  1191. 13220  val#$d0;rom area
  1192. 13230  valcrp+1;at $d000!
  1193. 13240  (NULL)crp+1
  1194. 13250 ;********************************
  1195. 13260 ;*                              *
  1196. 13270 ;* crp now contains pointer to  *
  1197. 13280 ;* the actual 8*8 - bit matrix  *
  1198. 13290 ;* of the character to be dis-  *
  1199. 13300 ;* played. these 8 bytes are    *
  1200. 13310 ;* now copied into " matbuf ".  *
  1201. 13320 ;*                              *
  1202. 13330 ;********************************
  1203. 13340  (NULL);irq off,
  1204. 13350  mid$#$33;character
  1205. 13360  (NULL)1;rom on !
  1206. 13370  len#7
  1207. 13380 matcopy mid$(crp),y
  1208. 13390  (NULL)matbuf,y
  1209. 13400  (NULL)
  1210. 13410  (NULL)matcopy
  1211. 13420  mid$#$37;character
  1212. 13430  (NULL)1;rom off,
  1213. 13440  (NULL);irq on .
  1214. 13450 ;********************************
  1215. 13460 ;*                              *
  1216. 13470 ;*  column and line values are  *
  1217. 13480 ;*  transformed into x/y coor-  *
  1218. 13490 ;*  dinates for accessing dots  *
  1219. 13500 ;*                              *
  1220. 13510 ;********************************
  1221. 13520  mid$tx
  1222. 13530  (NULL)
  1223. 13540  (NULL)
  1224. 13550  (NULL)
  1225. 13560  (NULL)bxl
  1226. 13570  mid$#0
  1227. 13580  val#0
  1228. 13590  (NULL)bxh
  1229. 13600  mid$ty
  1230. 13610  (NULL)
  1231. 13620  (NULL)
  1232. 13630  (NULL)
  1233. 13640  (NULL)xy
  1234. 13650 ;********************************
  1235. 13660 ;*                              *
  1236. 13670 ;*  one letter is printed into  *
  1237. 13680 ;*  the bit-map by isolating    *
  1238. 13690 ;*  each dot of its matrix ;    *
  1239. 13700 ;*                              *
  1240. 13710 ;*  testing if it is set by     *
  1241. 13720 ;*  anding with the powers of 2 *
  1242. 13730 ;*  (in tab3); isolating the    *
  1243. 13740 ;*  zero flag after this opera- *
  1244. 13750 ;*  tion that indicates the     *
  1245. 13760 ;*  equality, inverting it,     *
  1246. 13770 ;*                              *
  1247. 13780 ;*  and finally storing it as   *
  1248. 13790 ;*  the clear/set parameter of  *
  1249. 13800 ;*  the " access " routine.     *
  1250. 13810 ;*                              *
  1251. 13820 ;********************************
  1252. 13830  mid$expy
  1253. 13840  asc#3
  1254. 13850  (NULL)xyc
  1255. 13860  mid$#0
  1256. 13870  (NULL)high
  1257. 13880 linebegin mid$#7
  1258. 13890  (NULL)low
  1259. 13900  mid$bxl
  1260. 13910  (NULL)xxl
  1261. 13920  mid$bxh
  1262. 13930  (NULL)xxh
  1263. 13940 setloop lenhigh
  1264. 13950  peeklow
  1265. 13960  mid$matbuf,y
  1266. 13970  asctab3,x
  1267. 13980  (NULL)
  1268. 13990  (NULL);isolate
  1269. 14000  asc#2;zero flag
  1270. 14010  left$#2;& invert
  1271. 14020  (NULL)2;-> clear
  1272. 14030  mid$expx;   or set
  1273. 14040  asc#3
  1274. 14050  (NULL)xxc
  1275. 14060 multiple lcclosexxl,xxh,xy
  1276. 14070  (NULL)access
  1277. 14080  inwclosexxl
  1278. 14090  chr$xxc;expand x
  1279. 14100  (NULL)multiple
  1280. 14110  chr$low
  1281. 14120  (NULL)setloop
  1282. 14130  right$xy
  1283. 14140  chr$xyc;expand y
  1284. 14150  (NULL)linebegin
  1285. 14160  right$high
  1286. 14170  mid$expy
  1287. 14180  asc#3
  1288. 14190  (NULL)xyc
  1289. 14200  mid$high
  1290. 14210  str$#print#
  1291. 14220  (NULL)linebegin
  1292. 14230 nextcol peektx
  1293. 14240  (NULL)
  1294. 14250  (NULL)
  1295. 38836  (NULL)
  1296. 14270  valexpx
  1297. 14280  (NULL)tx
  1298. 14290  (NULL)textloop
  1299. 15000 ;--------------------------------
  1300. 15010 ;
  1301. 15020 ;       circle / ccircle
  1302. 15030 ;       ================
  1303. 15040 ;
  1304. 15050 ;  zeichnet/loescht einen kreis.
  1305. 15060 ;  der mittelpunkt des kreises
  1306. 15070 ;  steht in den a,x,y registern.
  1307. 15080 ;
  1308. 15090 ;   der radius steht in "rad".
  1309. 15100 ;
  1310. 15110 ;--------------------------------
  1311. 15120 mxl then1
  1312. 15130 mxh then1
  1313. 15140 my then1
  1314. 15150 c1 then1
  1315. 15160 c2 then1
  1316. 15170 c3 then1
  1317. 15180 c4 then1
  1318. 15190 tab(cdot=access
  1319. 15200 getcs
  1320. 15210  mid$low
  1321. 15220  peekhigh
  1322. 15230  (NULL)cdot
  1323. 15240 new
  1324. 15250 circle (NULL)
  1325. 15260  mid$#1
  1326. 15270  (NULL)*+5
  1327. 15280 ccircle (NULL)
  1328. 15290  mid$#0
  1329. 15300  (NULL)2
  1330. 15310  (NULL)
  1331. 15320  scclosemxl,mxh,my
  1332. 15330  right$rad
  1333. 15340  peekrad
  1334. 15350  tan#2
  1335. 15360  (NULL)readlt
  1336. 15370  (NULL)
  1337. 15380 readlt mid$lt1,x
  1338. 15390  (NULL)c1
  1339. 15400  mid$lt2,x
  1340. 15410  (NULL)c2
  1341. 15420  (NULL)
  1342. 15430  (NULL)c4
  1343. 15440  lenrad
  1344. 15450  (NULL)$b3a2
  1345. 15460  (NULL)$bc0c
  1346. 15470  len#$4b
  1347. 15480  (NULL)$b3a2
  1348. 15490  (NULL)$ba2b
  1349. 15500  (NULL)$bafe
  1350. 15510  (NULL)$bafe
  1351. 15520  (NULL)$bc9b
  1352. 15530  mid$#0
  1353. 15540  (NULL)c3
  1354. 15550 cloop peekc3
  1355. 15560  (NULL)
  1356. 15570  mid$c1
  1357. 15580  (NULL)lt1,x
  1358. 15590  (NULL)low
  1359. 15600  mid$c2
  1360. 15610  (NULL)lt2,x
  1361. 15620  (NULL)high
  1362. 15630  peekc4
  1363. 15640  mid$lt2,x
  1364. 15650  str$high
  1365. 15660  (NULL)cl1
  1366. 15670  (NULL)cl3
  1367. 15680  (NULL)cl2
  1368. 15690 cl1 mid$lt1,x
  1369. 15700  str$low
  1370. 15710  (NULL)cl3
  1371. 15720 cl2 chr$c4
  1372. 15730 cl3 (NULL)
  1373. 15740  mid$c4
  1374. 15750  valmy
  1375. 15760  (NULL)
  1376. 15770  (NULL)
  1377. 15780  mid$mxl
  1378. 15790  valc3
  1379. 15800  (NULL)low
  1380. 15810  mid$mxh
  1381. 15820  val#0
  1382. 15830  (NULL)high
  1383. 15840  cs
  1384. 15850  (NULL)
  1385. 15860  mid$my
  1386. 15870  (NULL)c4
  1387. 15880  (NULL)
  1388. 15890  cs
  1389. 15900  (NULL)
  1390. 15910  mid$my
  1391. 15920  valc4
  1392. 15930  (NULL)
  1393. 15940  (NULL)
  1394. 15950  mid$mxl
  1395. 15960  (NULL)c3
  1396. 15970  (NULL)low
  1397. 15980  mid$mxh
  1398. 15990  (NULL)#0
  1399. 16000  (NULL)high
  1400. 16010  cs
  1401. 16020  (NULL)
  1402. 16030  mid$my
  1403. 16040  (NULL)c4
  1404. 16050  (NULL)
  1405. 16060  cs
  1406. 16070  (NULL)
  1407. 16080  mid$mxl
  1408. 16090  valc4
  1409. 16100  (NULL)low
  1410. 16110  mid$mxh
  1411. 16120  val#0
  1412. 16130  (NULL)high
  1413. 16140  (NULL)
  1414. 16150  mid$my
  1415. 16160  valc3
  1416. 16170  (NULL)
  1417. 16180  cs
  1418. 16190  (NULL)
  1419. 16200  mid$my
  1420. 16210  (NULL)c3
  1421. 16220  (NULL)
  1422. 16230  cs
  1423. 16240  (NULL)
  1424. 16250  mid$mxl
  1425. 16260  (NULL)c4
  1426. 16270  (NULL)low
  1427. 16280  mid$mxh
  1428. 16290  (NULL)#0
  1429. 16300  (NULL)high
  1430. 16310  (NULL)
  1431. 16320  mid$my
  1432. 16330  valc3
  1433. 16340  (NULL)
  1434. 16350  cs
  1435. 16360  (NULL)
  1436. 16370  mid$my
  1437. 16380  (NULL)c3
  1438. 16390  (NULL)
  1439. 16400  cs
  1440. 16410  (NULL)
  1441. 16420  mid$c3
  1442. 16430  val#1
  1443. 16440  (NULL)c3
  1444. 16450  str$$65
  1445. 16460  (NULL)cterm
  1446. 16470  (NULL)cloop
  1447. 16480 cterm (NULL)
  1448. 16490 ;--------------------------------
  1449. 16500 ;
  1450. 16510 ;    draw lines / clear lines
  1451. 16520 ;    ======(NULL)=======(NULL)=========
  1452. 16530 ;
  1453. 16540 ; diese routinen erhalten einen
  1454. 16550 ; zeiger in (a/y) auf eine
  1455. 16560 ; koordinatentabelle.
  1456. 16570 ;
  1457. 16580 ; die eintraege dieser tabelle
  1458. 16590 ; werden als die koordinaten
  1459. 16600 ; von endpunkten von zusammen-
  1460. 16610 ; haengenden linien interpretiert.
  1461. 16620 ; von einem punkt zum naechsten
  1462. 16630 ; wird jeweils eine linie
  1463. 16640 ; gezeichnet / geloescht.
  1464. 16650 ; das ende der tabelle wird mar-
  1465. 16660 ; kiert durch eine x koordinate
  1466. 16670 ; >= $8000.
  1467. 16680 ;--------------------------------
  1468. 16690 getctfclosepar
  1469. 16700 ;coordinate transfer
  1470. 16710  mid$(low),y
  1471. 16720  (NULL)par
  1472. 16730  (NULL)
  1473. 16740 new
  1474. 16750 lines peek#1
  1475. 16760  (NULL)*+4
  1476. 16770 clines peek#0
  1477. 16780  (NULL)2
  1478. 16790  (NULL)low
  1479. 16800  (NULL)high
  1480. 16810 loop len#4;second dot
  1481. 16820  mid$(low),y;table end?
  1482. 16830  (NULL)contlines
  1483. 16840  (NULL)
  1484. 16850 contlines len#0
  1485. 16860  ctfclosex0l
  1486. 16870  ctfclosex0h
  1487. 16880  ctfclosey0
  1488. 16890  ctfclosex1l
  1489. 16900  ctfclosex1h
  1490. 16910  ctfclosey1
  1491. 16920  mid$low
  1492. 16930  (NULL)
  1493. 16940  val#3
  1494. 16950  (NULL)low
  1495. 16960  mid$high
  1496. 16970  val#0
  1497. 16980  (NULL)high
  1498. 16990  (NULL)accessline
  1499. 17000  (NULL)loop
  1500. 17010 ;--------------------------------
  1501. 17020 ;
  1502. 17030 ;  *** ende des quelltextes ***
  1503. 17040 ;
  1504. 17050 ; ab hier platz fuer zusaetzliche
  1505. 17060 ; grafik-routinen!
  1506. 17070 ;
  1507. 17080 ;--------------------------------
  1508.